home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / System source / Struct1 < prev    next >
Encoding:
Text File  |  1991-07-21  |  2.9 KB  |  113 lines  |  [TEXT/YERK]
  1. \ struct1 - additional data structures
  2. \  2/20/85  cbd Version 1
  3. \  1/17/88    rfl fixed remove: wordcol
  4. \  3/13/90    rfl    at2,to2 in warray
  5. \  5/23/90    rfl added bytecol
  6. \  8/08/90    rfl    fixed wordcol and bytecol to find negative numbers
  7. \  9/30/90    rfl added +to: barray;++2,++1
  8. \  7/21/91    rfl fixed remove: bytecol
  9. Decimal
  10.  
  11. :CLASS  wArray  <Super  Object  2 <Indexed
  12.  
  13.     :M  AT:        ?idx at2    ;M
  14.     :M  TO:        ?idx to2    ;M
  15.     :M  +TO:    ?idx ++2 ;M
  16.     :M  FILL:    ?ixObj limit 0
  17.         DO  dup i to: self LOOP  drop    ;M
  18.  
  19.     :M  PUT:  ?ixObj limit 0
  20.         DO   limit i- 1- (^elem) w!  LOOP   ;M
  21.  
  22.     \ ( -- e0 e1 ...en)  Indexed GET: places elements on stack
  23.     :M  GET:  ?ixObj limit  0 DO i (^elem) w@  LOOP ;M
  24.  
  25. ;CLASS
  26.  
  27. :CLASS wordCol  <Super wArray
  28.  
  29.     Int        Size    \ # elements in list
  30.  
  31.     \ ( -- curSize )  Return #elements currently in list
  32.     :M  SIZE:  Get: Size  ;M
  33.  
  34.     \ ( -- )  set to null list
  35.     :M  CLEAR:  Clear: Size   Clear: Super  ;M
  36.  
  37.     \ ( -- ^file )  return contents of end of list
  38.     :M  LAST:  get: size  dup 0= classerr" 136
  39.         1- at: self    ;M
  40.  
  41.     \ ( val -- )   Add value to end of list
  42.     :M  ADD:  Get: Size  limit  >=
  43.         classErr" 137  Get: size  To: Self
  44.         1 +: Size   ;M
  45.  
  46.     \ ( ind -- )  remove the element at index
  47.     :M  REMOVE: { ind -- }  ind   Get: size >=
  48.         classErr" 136 get: size 1- ind
  49.         DO  i 1+ at: self  i to: self LOOP  -1 +: size  ;M
  50.  
  51.     \ ( val -- ind t  OR f)  Find a value in an OC
  52.     :M  INDEXOF:  0 swap Get: Size  0
  53.         DO i  at2
  54.             over = IF 2drop  i 1 1 leave THEN
  55.         LOOP  drop  ;M
  56.  
  57. ;CLASS
  58.  
  59. :CLASS bArray  <Super Object  1 <Indexed
  60.  
  61.     :M  AT: ?idx at1 ;M
  62.     :M  TO: ?idx to1 ;M
  63.     :M +TO: ?idx ++1 ;M
  64.  
  65.     \ ( val -- )
  66.     :M  FILL:  ?ixObj idxBase  limit  rot  Fill  ;M
  67.  
  68.     \ ( e0 e1... en -- )  indexed PUT: loads array from stack
  69.     :M  PUT:  ?ixObj limit 0
  70.         DO   limit i- 1- to1  LOOP   ;M
  71.  
  72.     \ ( -- e0 e1 ...en)  Indexed GET: places elements on stack
  73.     :M  GET:  ?ixObj limit  0 DO i at1  LOOP ;M
  74.  
  75. ;CLASS
  76.  
  77.  
  78. :CLASS ByteCol  <SUPER bArray
  79.  
  80.     Int     Size   \ # elements in list
  81.  
  82.     ( -- curSize )  ( Return #elements currently in list )
  83.     :M  SIZE:  Get: Size  ;M
  84.  
  85.     :M SetSize: put: size ;M
  86.  
  87.     ( -- )  ( set to null list )
  88.     :M  CLEAR:  Clear: Size   Clear: Super  ;M
  89.  
  90.     ( -- ^file )  ( return contents of end of list )
  91.     :M  LAST:  get: size  dup 0= classerr" 136
  92.         1- at: self    ;M
  93.  
  94.     ( val -- )   ( Add value to end of list )
  95.     :M  ADD:  Get: Size  limit  >=
  96.         classErr" 137  Get: size  To: Self
  97.         1 +: Size   ;M
  98.  
  99.     ( ind -- )  ( remove the element at index )
  100.     :M  REMOVE: { ind -- }  ind   Get: size >=
  101.         classErr" 136 Get: size 1- ind
  102.         DO  I 1+ at: self  I to: self LOOP  -1 +: size  ;M
  103.  
  104.     ( val -- ind t  OR f) ( Find a value in an OC)
  105. \ even though bytecol recalls as positive numbers, this will
  106. \ find a negative number in the array
  107.     :M  INDEXOF:  dup 0< IF 256 swap + THEN 0 swap Get: Size  0
  108.         DO I  at1 
  109.             over = IF 2drop  I 1 1 leave THEN
  110.         LOOP  drop  ;M
  111.  
  112. ;CLASS
  113.